home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / holidays.el < prev    next >
Lisp/Scheme  |  1996-03-22  |  16KB  |  385 lines
  1. ;;; holidays.el --- holiday functions for the calendar package
  2.  
  3. ;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
  6. ;; Keywords: holidays, calendar
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;; This collection of functions implements the holiday features as described
  28. ;; in calendar.el.
  29.  
  30. ;; Comments, corrections, and improvements should be sent to
  31. ;;  Edward M. Reingold               Department of Computer Science
  32. ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
  33. ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
  34. ;;                                   Urbana, Illinois 61801
  35.  
  36. ;; Technical details of all the calendrical calculations can be found in
  37. ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
  38. ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
  39. ;; pages 899-928.  ``Calendrical Calculations, Part II: Three Historical
  40. ;; Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M. Clamen,
  41. ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
  42. ;; pages 383-404.
  43.  
  44. ;; Hard copies of these two papers can be obtained by sending email to
  45. ;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
  46. ;; the message BODY containing your mailing address (snail).
  47.  
  48. ;;; Code:
  49.  
  50. (require 'calendar)
  51.  
  52. (autoload 'holiday-julian "cal-julian"
  53.   "Holiday on MONTH, DAY  (Julian) called STRING."
  54.   t)
  55.  
  56. (autoload 'holiday-hebrew "cal-hebrew"
  57.   "Holiday on MONTH, DAY (Hebrew) called STRING."
  58.   t)
  59.  
  60. (autoload 'holiday-rosh-hashanah-etc "cal-hebrew"
  61.   "List of dates related to Rosh Hashanah, as visible in calendar window."
  62.   t)
  63.  
  64. (autoload 'holiday-hanukkah "cal-hebrew"
  65.   "List of dates related to Hanukkah, as visible in calendar window."
  66.   t)
  67.  
  68. (autoload 'holiday-passover-etc "cal-hebrew"
  69.   "List of dates related to Passover, as visible in calendar window."
  70.   t)
  71.  
  72. (autoload 'holiday-tisha-b-av-etc "cal-hebrew"
  73.   "List of dates around Tisha B'Av, as visible in calendar window."
  74.   t)
  75.  
  76. (autoload 'holiday-islamic "cal-islam"
  77.   "Holiday on MONTH, DAY (Islamic) called STRING."
  78.   t)
  79.  
  80. (autoload 'holiday-chinese-new-year "cal-china"
  81.   "Date of Chinese New Year."
  82.   t)
  83.  
  84. (autoload 'solar-equinoxes-solstices "solar"
  85.   "Date and time of equinoxes and solstices, if visible in the calendar window.
  86. Requires floating point."
  87.   t)
  88.  
  89. (defun holidays (&optional arg)
  90.   "Display the holidays for last month, this month, and next month.
  91. If called with an optional prefix argument, prompts for month and year.
  92.  
  93. This function is suitable for execution in a .emacs file."
  94.   (interactive "P")
  95.   (save-excursion
  96.     (let* ((completion-ignore-case t)
  97.            (date (if arg
  98.                      (calendar-read-date t)
  99.                    (calendar-current-date)))
  100.            (displayed-month (extract-calendar-month date))
  101.            (displayed-year (extract-calendar-year date)))
  102.       (list-calendar-holidays))))
  103.  
  104. (defun check-calendar-holidays (date)
  105.   "Check the list of holidays for any that occur on DATE.
  106. The value returned is a list of strings of relevant holiday descriptions.
  107. The holidays are those in the list calendar-holidays."
  108.   (let* ((displayed-month (extract-calendar-month date))
  109.          (displayed-year (extract-calendar-year date))
  110.          (h (calendar-holiday-list))
  111.          (holiday-list))
  112.     (while h
  113.       (if (calendar-date-equal date (car (car h)))
  114.           (setq holiday-list (append holiday-list (cdr (car h)))))
  115.       (setq h (cdr h)))
  116.     holiday-list))
  117.  
  118. (defun calendar-cursor-holidays ()
  119.   "Find holidays for the date specified by the cursor in the calendar window."
  120.   (interactive)
  121.   (message "Checking holidays...")
  122.   (let* ((date (calendar-cursor-to-date t))
  123.          (date-string (calendar-date-string date))
  124.          (holiday-list (check-calendar-holidays date))
  125.          (holiday-string (mapconcat 'identity holiday-list ";  "))
  126.          (msg (format "%s:  %s" date-string holiday-string)))
  127.     (if (not holiday-list)
  128.         (message "No holidays known for %s" date-string)
  129.       (if (<= (length msg) (frame-width))
  130.           (message "%s" msg)
  131.         (set-buffer (get-buffer-create holiday-buffer))
  132.         (setq buffer-read-only nil)
  133.         (calendar-set-mode-line date-string)
  134.         (erase-buffer)
  135.         (insert (mapconcat 'identity holiday-list "\n"))
  136.         (goto-char (point-min))
  137.         (set-buffer-modified-p nil)
  138.         (setq buffer-read-only t)
  139.         (display-buffer holiday-buffer)
  140.         (message "Checking holidays...done")))))
  141.  
  142. (defun mark-calendar-holidays ()
  143.   "Mark notable days in the calendar window."
  144.   (interactive)
  145.   (setq mark-holidays-in-calendar t)
  146.   (message "Marking holidays...")
  147.   (let ((holiday-list (calendar-holiday-list)))
  148.     (while holiday-list
  149.       (mark-visible-calendar-date
  150.        (car (car holiday-list)) calendar-holiday-marker)
  151.       (setq holiday-list (cdr holiday-list))))
  152.   (message "Marking holidays...done"))
  153.  
  154. (defun list-calendar-holidays ()
  155.   "Create a buffer containing the holidays for the current calendar window.
  156. The holidays are those in the list calendar-notable-days.  Returns t if any
  157. holidays are found, nil if not."
  158.   (interactive)
  159.   (message "Looking up holidays...")
  160.   (let ((holiday-list (calendar-holiday-list))
  161.         (m1 displayed-month)
  162.         (y1 displayed-year)
  163.         (m2 displayed-month)
  164.         (y2 displayed-year))
  165.     (if (not holiday-list)
  166.         (progn
  167.           (message "Looking up holidays...none found")
  168.           nil)
  169.       (set-buffer (get-buffer-create holiday-buffer))
  170.       (setq buffer-read-only nil)
  171.       (increment-calendar-month m1 y1 -1)
  172.       (increment-calendar-month m2 y2 1)
  173.       (calendar-set-mode-line
  174.        (if (= y1 y2)
  175.            (format "Notable Dates from %s to %s, %d%%-"
  176.                    (calendar-month-name m1) (calendar-month-name m2) y2)
  177.          (format "Notable Dates from %s, %d to %s, %d%%-"
  178.                  (calendar-month-name m1) y1 (calendar-month-name m2) y2)))
  179.       (erase-buffer)
  180.       (insert
  181.        (mapconcat
  182.         '(lambda (x) (concat (calendar-date-string (car x))
  183.                              ": " (car (cdr x))))
  184.         holiday-list "\n"))
  185.       (goto-char (point-min))
  186.       (set-buffer-modified-p nil)
  187.       (setq buffer-read-only t)
  188.       (display-buffer holiday-buffer)
  189.       (message "Looking up holidays...done")
  190.       t)))
  191.  
  192. (defun calendar-holiday-list ()
  193.   "Form the list of holidays that occur on dates in the calendar window.
  194. The holidays are those in the list calendar-holidays."
  195.   (let ((p calendar-holidays)
  196.         (holiday-list))
  197.     (while p
  198.       (let* ((holidays
  199.               (if calendar-debug-sexp
  200.                   (let ((stack-trace-on-error t))
  201.                     (eval (car p)))
  202.                 (condition-case nil
  203.                     (eval (car p))
  204.                   (error (beep)
  205.                          (message "Bad holiday list item: %s" (car p))
  206.                          (sleep-for 2))))))
  207.         (if holidays
  208.             (setq holiday-list (append holidays holiday-list))))
  209.       (setq p (cdr p)))
  210.     (setq holiday-list (sort holiday-list 'calendar-date-compare))))
  211.  
  212. ;; Below are the functions that calculate the dates of holidays; these
  213. ;; are ev